home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-03
/
baswiz19.zip
/
BW$BAS.ZIP
/
G13MAKEB.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-31
|
2KB
|
57 lines
' +----------------------------------------------------------------------+
' | |
' | BASWIZ Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' | The BASIC Wizard's Library |
' | |
' +----------------------------------------------------------------------+
DECLARE SUB FOpen (File$, FMode$, BufferLen%, Handle%, ErrCode%)
DECLARE SUB FBlockWrite (BYVAL Handle%, BYVAL Segm%, BYVAL Ofs%, BYVAL Bytes%)
DECLARE FUNCTION FGetError% (BYVAL Handle%)
DECLARE SUB FWrite (BYVAL Handle%, St$)
DECLARE SUB FClose (Handle%)
DECLARE FUNCTION G13GetPel% (BYVAL X%, BYVAL Y%)
DECLARE SUB VGetPalette (BYVAL PalReg%, Red%, Green%, Blue%)
DECLARE SUB PalBlk1 (BYVAL DSeg%, BYVAL DOfs%, BYVAL Colors%)
SUB G13MakeBMP (File$, X1%, Y1%, X2%, Y2%, ErrCode%)
PicWidth% = (X2% - X1%) + 1
PicHeight% = (Y2% - Y1%) + 1
IF PicWidth% > 0 AND PicHeight% > 0 THEN
ErrCode% = 0
FOpen File$, "CW", 0, Handle%, ErrCode%
ELSE
ErrCode% = -5
END IF
IF ErrCode% = 0 THEN
WidthFiller% = ((PicWidth% + 3) \ 4) * 4 - PicWidth%
FileSize& = 1078& + CLNG(PicWidth% + WidthFiller%) * CLNG(PicHeight%)
FWrite Handle%, "BM" + MKL$(FileSize&) + MKL$(0) + MKL$(1078) + MKL$(40) + MKL$(PicWidth%) + MKL$(PicHeight%) + MKI$(1) + MKI$(8) + STRING$(6 * 4, 0)
ErrCode% = FGetError%(Handle%)
'----- write the palette -----
DIM Pal&(0 TO 255)
DSeg% = VARSEG(Pal&(0))
DOfs% = VARPTR(Pal&(0))
PalBlk1 DSeg%, DOfs%, 256
FBlockWrite Handle%, DSeg%, DOfs%, 256 * 4
'----- write the image -----
IF ErrCode% = 0 THEN
St$ = STRING$(PicWidth% + WidthFiller%, 0)
FOR y% = Y2% to Y1% step -1
FOR x% = X1% TO X2%
MID$(St$, x% - X1% + 1, 1) = CHR$(G13GetPel(x%, y%))
NEXT
FWrite Handle%, St$
ErrCode% = FGetError%(Handle%)
IF ErrCode% THEN EXIT FOR
NEXT
END IF
FClose Handle%
END IF
END SUB